home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue30 / bdeorx / BDEDORX.ZIP / RestDevl / Restruc1.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1997-12-15  |  23.7 KB  |  765 lines
  1. unit Restruc1;
  2. {
  3. *********************************************************
  4. *                                                       *
  5. *  demo for use of def files with local tables          *
  6. *                                                       *
  7. *  (c) 1996-97 Reinhard Kalinke                         *
  8. *                                                       *
  9. *********************************************************
  10. }                              
  11.  
  12. {NOTE: You are not allowed to give this or a similar application
  13.  away as a whole, that is including any method to write def files!}
  14.  
  15. {NOTE: When compiling the samples or a project of your own using 
  16. BDEDoRxS methods with Delphi 1 tests seem to indicate that you 
  17. better increase stack size to 24 or even 32k.}
  18.  
  19. interface
  20.  
  21. uses
  22.   WinTypes, WinProcs, Messages, SysUtils, Classes, Graphics, Controls,
  23.   Forms, Dialogs, StdCtrls, FileCtrl, DB, Px7Table, IniFiles, ExtCtrls,
  24.   {$IFDEF WIN32}
  25.   ComCtrls,
  26.   {$ELSE}
  27.   Gauges,{}
  28.   {$ENDIF}
  29.   DBIProcs, DBITypes, DBIErrs, DBTables;
  30.  
  31. type
  32.   TMainForm = class(TForm)
  33.     GroupBox1: TGroupBox;
  34.     AliasCB: TComboBox;
  35.     GroupBox2: TGroupBox;
  36.     DriveBox1: TDriveComboBox;
  37.     DirBox1: TDirectoryListBox;
  38.     GroupBox3: TGroupBox;
  39.     GroupBox4: TGroupBox;
  40.     FileBox1: TFileListBox;
  41.     TblCreateCB: TCheckBox;
  42.     IndexCB: TCheckBox;
  43.     AllBtn: TButton;
  44.     NoneBtn: TButton;
  45.     DoItBtn: TButton;
  46.     CloseBtn: TButton;
  47.     RestTbl: TPx7Table;
  48.     RestDB: TDatabase;
  49.     DeleteCB: TCheckBox;
  50.     ValcheckCB: TCheckBox;
  51.     RefIntCB: TCheckBox;
  52.     OpRG: TRadioGroup;
  53.     Panel1: TPanel;
  54.     Panel2: TPanel;
  55.     IdxCB: TCheckBox;
  56.     Edit1: TEdit;
  57.     Label1: TLabel;
  58.     FieldIDCB: TCheckBox;
  59.     procedure FormShow(Sender: TObject);
  60.     procedure AliasCBChange(Sender: TObject);
  61.     procedure FormCreate(Sender: TObject);
  62.     procedure DoItBtnClick(Sender: TObject);
  63.     procedure AllBtnClick(Sender: TObject);
  64.     procedure CloseBtnClick(Sender: TObject);
  65.     procedure OpRGClick(Sender: TObject);
  66.     procedure FileBox1Change(Sender: TObject);
  67.     procedure Label1Click(Sender: TObject);
  68.     procedure ValcheckCBClick(Sender: TObject);
  69.     procedure IdxCBClick(Sender: TObject);
  70.   private
  71.     { Private-Deklarationen }
  72.     FCalced: boolean;
  73.     FBDEVersion: string;
  74.     FDeleteVals: boolean;
  75.     FPreventSizing: boolean;
  76.     {$IFDEF WIN32}
  77.     ProgressBar1: TProgressBar;
  78.     {$ELSE}
  79.     ProgressBar1: TGauge;
  80.     {$ENDIF}
  81.     {not currently needed by this project as it's window
  82.      style is bsSingle. included for use with other styles}
  83.     procedure WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo);
  84.               message WM_GETMINMAXINFO;
  85.     procedure WMNCHitTest(var Msg: TWMNCHitTest);
  86.               message WM_NCHitTest;
  87.     procedure WMInitMenuPopup(var Msg: TWMInitMenuPopup);
  88.               message WM_INITMENUPOPUP;
  89.   public
  90.     { Public-Deklarationen }
  91.   end;
  92.  
  93. var
  94.   MainForm: TMainForm;
  95.  
  96. implementation
  97.  
  98. {$R *.DFM}
  99.  
  100. uses BDEDoRxS;
  101.  
  102. procedure AssignDBDir(ADataBase: TDataBase; const AFileName: TFileName);
  103. begin
  104.   with ADataBase do
  105.   if (Params.Count = 0)
  106.   or (Params[0] <> 'PATH='+AFileName) then
  107.   begin
  108.     if Connected then Connected := False;
  109.     DriverName := 'STANDARD'; {clears any alias as well}
  110.     Params.Clear;
  111.     Params.Add('PATH='+AFileName);
  112.     Open;
  113.   end;
  114. end;
  115.  
  116. {'Wrappers' you might want to paste into your apps/restructors.
  117.  For an example on how to use them check form method DoItBtnClick}
  118.  
  119. procedure SetProgress({$IFDEF WIN32}AProgressBar: TProgressBar;
  120.                       {$ELSE}AProgressBar: TGauge;{$ENDIF}
  121.                       const Count: integer; Reset: boolean);
  122. begin
  123.   if Reset then
  124.   begin
  125.     {$IFDEF WIN32}
  126.     AProgressBar.Position := 0;
  127.     AProgressBar.Max := Count;
  128.     {$ELSE}
  129.     AProgressBar.Progress := 0;
  130.     AProgressBar.MaxValue := Count; {}
  131.     {$ENDIF}
  132.   end
  133.   else
  134.     {$IFDEF WIN32}
  135.     AProgressBar.Position := Count;
  136.     {$ELSE}
  137.     AProgressBar.Progress := Count; {}
  138.     {$ENDIF}
  139. end;
  140.  
  141. {writes table defs for a list of tables}
  142. procedure DoWriteTableDefsToFile(AFileList: TStrings;
  143.                                  ATable: TTable;
  144.                                  const AVersion: string;
  145.                                  DoUseFieldIDs: boolean;
  146.                                  {$IFDEF WIN32}
  147.                                  AProgressBar: TProgressBar;
  148.                                  {$ELSE}
  149.                                  AProgressBar: TGauge;{}
  150.                                  {$ENDIF}
  151.                                  AStatusPanel: TPanel);
  152. var i,iProg: integer;
  153.     DBFile, DefFile: TFileName;
  154. begin
  155.   Screen.Cursor := crHourGlass;
  156.   try
  157.     iProg := 0;
  158.     SetProgress(AProgressBar,AFileList.Count,True);
  159.     for i:=0 to pred(AFileList.Count) do
  160.     begin
  161.       DBFile := AFileList.Strings[i];
  162.       DefFile := ChangeFileExt(DBFile,'.dbi');
  163.       with TIniFile.Create(DefFile) do
  164.       try
  165.         ATable.TableName := ExtractFileName(DBFile);
  166.         ATable.Open;
  167.         AStatusPanel.Caption := 'creating table def: '
  168.                                 +DefFile;
  169.         AStatusPanel.Update;
  170.         BDESaveTableDefsToFile(ATable, DefFile);
  171.         if (AVersion > '') then
  172.           WriteString('Table','Version',AVersion);
  173.         if DoUseFieldIDs then
  174.           WriteString('Table','FieldCompare','ByFieldID')
  175.         else
  176.           WriteString('Table','FieldCompare','ByFieldName');
  177.       finally
  178.         Free;
  179.         ATable.Close;
  180.       end;
  181.       inc(iProg);
  182.       SetProgress(AProgressBar,iProg,False);
  183.     end;
  184.     AStatusPanel.Caption := 'Done!';
  185.     AStatusPanel.Update;
  186.   finally
  187.     Screen.Cursor := crDefault;
  188.   end;
  189. end;
  190.  
  191. {writes index defs only for a list of tables}
  192. procedure DoWriteIndexDefsToFile(AFileList: TStrings;
  193.                                  ATable: TTable;
  194.                                  const AVersion: string;
  195.                                  {$IFDEF WIN32}
  196.                                  AProgressBar: TProgressBar;
  197.                                  {$ELSE}
  198.                                  AProgressBar: TGauge;
  199.                                  {$ENDIF}
  200.                                  AStatusPanel: TPanel);
  201. var i,iProg: integer;
  202.     DBFile, DefFile: TFileName;
  203. begin
  204.   Screen.Cursor := crHourGlass;
  205.   try
  206.     iProg := 0;
  207.     SetProgress(AProgressBar,AFileList.Count,True);
  208.     for i:=0 to pred(AFileList.Count) do
  209.     begin
  210.       DBFile := AFileList.Strings[i];
  211.       DefFile := ChangeFileExt(DBFile,'.dbx');
  212.       with TIniFile.Create(DefFile) do
  213.       try
  214.         ATable.TableName := ExtractFileName(DBFile);
  215.         ATable.Open;
  216.         AStatusPanel.Caption := 'creating index def: '
  217.                                 +DefFile;
  218.         AStatusPanel.Update;
  219.         BDESaveIndexDefsToFile(ATable, DefFile);
  220.         if (AVersion > '') then
  221.           WriteString('Table','Version',AVersion);
  222.       finally
  223.         Free;
  224.         ATable.Close;
  225.       end;
  226.       inc(iProg);
  227.       SetProgress(AProgressBar,iProg,False);
  228.     end;
  229.     AStatusPanel.Caption := 'Done!';
  230.     AStatusPanel.Update;
  231.   finally
  232.     Screen.Cursor := crDefault;
  233.   end;
  234. end;
  235.  
  236. {processes table defs with thw whole range of current
  237.  options (indices, RI, Val)}
  238. procedure DoRestructureFromFile(AFileList: TStrings;
  239.                                 ADataBase: TDataBase;
  240.                                 ATable: TTable;
  241.                                 {$IFDEF WIN32}
  242.                                 AProgressBar: TProgressBar;
  243.                                 {$ELSE}
  244.                                 AProgressBar: TGauge;
  245.                                 {$ENDIF}
  246.                                 AStatusPanel: TPanel;
  247.                                 const DoCreateTables,
  248.                                 DoCreateIndices,
  249.                                 DoCreateRefInt,
  250.                                 DoCreateValchecks,
  251.                                 DoDeleteDefs: boolean);
  252. var i,j,iProg,iPass,iPasses: integer;
  253.     DefFile, DBFile: TFileName;
  254.     DoIndex: boolean;
  255.     ActionStr: string;
  256.     ExcValue: DBIResult;
  257. begin
  258.   Screen.Cursor := crHourGlass;
  259.   try
  260.     DoIndex := DoCreateIndices;
  261.     if (DoCreateRefInt or DoCreateValchecks) then
  262.       iPasses := 2 else iPasses := 1;
  263.     SetProgress(AProgressBar,AFileList.Count*(1+ord(DoIndex)),True);
  264.     for iPass:=1 to iPasses do
  265.     begin
  266.       iProg := 0;
  267.       SetProgress(AProgressBar,iProg,False);
  268.       if (iPass = 1) then
  269.         ActionStr := 'processing: '
  270.       else
  271.         ActionStr := 'creating RI and/or ValChecks: ';
  272.       for i:=0 to pred(AFileList.Count) do
  273.       begin
  274.         DefFile := AFileList.Strings[i];
  275.         with TIniFile.Create(DefFile) do
  276.         try
  277.           ATable.TableName := ReadString('Table','Name','');
  278.           AStatusPanel.Caption := ActionStr+ATable.TableName;
  279.           AStatusPanel.Update;
  280.           if (iPass = 2) then
  281.           begin
  282.             ATable.Open;
  283.             {'Bugfix' BDE4.0:}
  284.             if MainForm.FDeleteVals then
  285.               BDEDropValFile(ATable);
  286.             if DoCreateRefInt then
  287.              {dropping existing RI is included
  288.               with below function}
  289.               BDEAddRIFromFile(ATable, DefFile);
  290.             inc(iProg);
  291.             SetProgress(AProgressBar,iProg,False);
  292.             if DoCreateValchecks then
  293.              {dropping existing val is included
  294.               with below function}
  295.               BDEAddValchecksFromFile(ATable, DefFile); {}
  296.             inc(iProg);
  297.             SetProgress(AProgressBar,iProg,False);
  298.             Continue;
  299.           end
  300.           else
  301.           try
  302.             ATable.Open;
  303.             BDERestructTableFromFile(ATable, DefFile);
  304.             inc(iProg);
  305.             SetProgress(AProgressBar,iProg,False);
  306.           except
  307.             on E:EDBEngineError do
  308.             begin
  309.               DoIndex := DoCreateIndices and DoCreateTables;
  310.               {if table does not exist:}
  311.               for j:=0 to pred(E.ErrorCount) do
  312.               begin
  313.                 if DoCreateTables
  314.                 and (E.Errors[j].ErrorCode = DBIERR_NOSUCHTABLE) then
  315.                 begin
  316.                   BDECreateTableFromFile(ADataBase, DefFile);
  317.                   inc(iProg);
  318.                   SetProgress(AProgressBar,iProg,False);
  319.                   ATable.Open;
  320.                   DBISaveChanges(ATable.Handle);
  321.                   Break;
  322.                 end
  323.                 else raise;
  324.               end;
  325.             end;
  326.             else raise;
  327.           end;
  328.           if DoIndex then
  329.             {dropping existing indices is included
  330.              with below function}
  331.             BDEAddIndicesFromFile(ATable, DefFile);
  332.           inc(iProg);
  333.           SetProgress(AProgressBar,iProg,False);
  334.         finally
  335.           Free;
  336.           ATable.Close;
  337.         end;
  338.       end;
  339.     end;
  340.     AStatusPanel.Caption := 'Done!';
  341.     AStatusPanel.Update;
  342.   finally
  343.     Screen.Cursor := crDefault;
  344.   end;
  345.   if DoDeleteDefs then
  346.   begin
  347.     for i:=0 to pred(AFileList.Count) do
  348.       SysUtils.DeleteFile(AFileList.Strings[i]);
  349.   end;
  350. end;
  351.  
  352. {processes table defs for field restructure and indices only
  353.  (no RI or Val processing)}
  354. procedure DoSimpleRestructureFromFile(AFileList: TStringList;
  355.                                 ADataBase: TDataBase;
  356.                                 ATable: TTable;
  357.                                 {$IFDEF WIN32}
  358.                                 AProgressBar: TProgressBar;
  359.                                 {$ELSE}
  360.                                 AProgressBar: TGauge;
  361.                                 {$ENDIF}
  362.                                 AStatusPanel: TPanel;
  363.                                 const DoCreateTables,
  364.                                 DoCreateIndices,
  365.                                 DoDeleteDefs: boolean);
  366. var i,j,iProg: integer;
  367.     DefFile, DBFile: TFileName;
  368.     DoIndex: boolean;
  369.     ExcValue: DBIResult;
  370. begin
  371.   Screen.Cursor := crHourGlass;
  372.   try
  373.     DoIndex := DoCreateIndices;
  374.     iProg := 0;
  375.     SetProgress(AProgressBar,AFileList.Count*(1+ord(DoIndex)),True);
  376.     for i:=0 to pred(AFileList.Count) do
  377.     begin
  378.       DefFile := AFileList.Strings[i];
  379.       with TIniFile.Create(DefFile) do
  380.       try
  381.         ATable.TableName := ReadString('Table','Name','');
  382.         AStatusPanel.Caption := 'processing: '+ATable.TableName;
  383.         AStatusPanel.Update;
  384.         try
  385.           ATable.Open;
  386.           BDERestructTableFromFile(ATable, DefFile);
  387.           inc(iProg);
  388.           SetProgress(AProgressBar,iProg,False);
  389.         except
  390.           on E:EDBEngineError do
  391.           begin
  392.             DoIndex := DoCreateIndices and DoCreateTables;
  393.             {if table does not exist:}
  394.             for j:=0 to pred(E.ErrorCount) do
  395.             begin
  396.               if DoCreateTables
  397.               and (E.Errors[j].ErrorCode = DBIERR_NOSUCHTABLE) then
  398.               begin
  399.                 BDECreateTableFromFile(ADataBase, DefFile);
  400.                 inc(iProg);
  401.                 SetProgress(AProgressBar,iProg,False);
  402.                 ATable.Open;
  403.                 DBISaveChanges(ATable.Handle);
  404.                 Break;
  405.               end
  406.               else raise;
  407.             end;
  408.           end;
  409.           else raise;
  410.         end;
  411.         if DoIndex then
  412.           BDEAddIndicesFromFile(ATable, DefFile);
  413.         inc(iProg);
  414.         SetProgress(AProgressBar,iProg,False);
  415.       finally
  416.         Free;
  417.         ATable.Close;
  418.       end;
  419.     end;
  420.     AStatusPanel.Caption := 'Done!';
  421.     AStatusPanel.Update;
  422.   finally
  423.     Screen.Cursor := crDefault;
  424.   end;
  425.   if DoDeleteDefs then
  426.   begin
  427.     for i:=0 to pred(AFileList.Count) do
  428.       SysUtils.DeleteFile(AFileList.Strings[i]);
  429.   end;
  430. end;
  431.  
  432. {processes defs for indices only}
  433. procedure DoProcessIndicesFromFile(AFileList: TStringList;
  434.                                    ATable: TTable;
  435.                                    {$IFDEF WIN32}
  436.                                    AProgressBar: TProgressBar;
  437.                                    {$ELSE}
  438.                                    AProgressBar: TGauge;
  439.                                    {$ENDIF}
  440.                                    AStatusPanel: TPanel;
  441.                                    const DoDeleteDefs: boolean);
  442. var i,iProg,iPass,iPasses: integer;
  443.     DefFile, DBFile: TFileName;
  444.     Res: integer;
  445.     FileRec: TSearchRec;
  446. begin
  447.   Screen.Cursor := crHourGlass;
  448.   try
  449.     iProg := 0;
  450.     SetProgress(AProgressBar,AFileList.Count,True);
  451.     for i:=0 to pred(AFileList.Count) do
  452.     begin
  453.       DefFile := AFileList.Strings[i];
  454.       with TIniFile.Create(DefFile) do
  455.       try
  456.         ATable.TableName := ReadString('Table','Name','');
  457.         AStatusPanel.Caption := 'creating indices: '+ATable.TableName;
  458.         AStatusPanel.Update;
  459.         ATable.Open;
  460.         {dropping indices is included with below function}
  461.         BDEAddIndicesFromFile(ATable, DefFile);
  462.         inc(iProg);
  463.         SetProgress(AProgressBar,iProg,False);
  464.       finally
  465.         Free;
  466.         ATable.Close;
  467.       end;
  468.     end;
  469.     AStatusPanel.Caption := 'Done!';
  470.     AStatusPanel.Update;
  471.   finally
  472.     Screen.Cursor := crDefault;
  473.   end;
  474.   if DoDeleteDefs then
  475.   begin
  476.     for i:=0 to pred(AFileList.Count) do
  477.       SysUtils.DeleteFile(AFileList.Strings[i]);
  478.   end;
  479. end;
  480.  
  481. {processes index defs for a list of files in case of
  482.  index errors ('Index out of date')}
  483. procedure DoRecoverIndicesFromFile(AFileList: TStringList;
  484.                                    ADB: TDataBase;
  485.                                    ATable: TTable;
  486.                                    {$IFDEF WIN32}
  487.                                    AProgressBar: TProgressBar;
  488.                                    {$ELSE}
  489.                                    AProgressBar: TGauge;
  490.                                    {$ENDIF}
  491.                                    AStatusPanel: TPanel;
  492.                                    const DoDeleteDefs: boolean);
  493. var i,iProg,iPass,iPasses: integer;
  494.     DefFile, DBFile: TFileName;
  495.     Res: integer;
  496.     FileRec: TSearchRec;
  497. begin
  498.   Screen.Cursor := crHourGlass;
  499.   try
  500.     iProg := 0;
  501.     SetProgress(AProgressBar,AFileList.Count,True);
  502.     for i:=0 to pred(AFileList.Count) do
  503.     begin
  504.       DefFile := AFileList.Strings[i];
  505.       with TIniFile.Create(DefFile) do
  506.       try
  507.         ATable.TableName := ReadString('Table','Name','');
  508.         AStatusPanel.Caption := 'recovering indices: '+ATable.TableName;
  509.         AStatusPanel.Update;
  510.         BDERecoverIndicesFromFile(ADB, ATable.TableName, DefFile);
  511.         inc(iProg);
  512.         SetProgress(AProgressBar,iProg,False);
  513.       finally
  514.         Free;
  515.       end;
  516.     end;
  517.     AStatusPanel.Caption := 'Done!';
  518.     AStatusPanel.Update;
  519.   finally
  520.     Screen.Cursor := crDefault;
  521.   end;
  522.   if DoDeleteDefs then
  523.   begin
  524.     for i:=0 to pred(AFileList.Count) do
  525.       SysUtils.DeleteFile(AFileList.Strings[i]);
  526.   end;
  527. end;
  528. {end of 'wrapper' section}
  529.  
  530. procedure TMainForm.DoItBtnClick(Sender: TObject);
  531. var AFileList: TStringList;
  532.     i: integer;
  533. begin
  534.   if (AliasCB.Text <> 'use Directories') then
  535.   begin
  536.     RestDB.Close;
  537.     RestDB.Params.Clear;
  538.     RestDB.AliasName := AliasCB.Text;
  539.     RestDB.Open;
  540.   end
  541.   else
  542.     AssignDBDir(RestDB,DirBox1.Directory);
  543.   AFileList := TStringList.Create;
  544.   try
  545.     for i:=0 to pred(FileBox1.Items.Count) do
  546.       if FileBox1.Selected[i] then
  547.         AFileList.Add(DirBox1.Directory+'\'+FileBox1.Items[i]);
  548.     if (Sender = DoItBtn) then
  549.     begin
  550.       if (OpRG.ItemIndex = 0) then
  551.       begin
  552.         if IdxCB.Checked then
  553.           DoWriteIndexDefsToFile(AFileList,RestTbl,Edit1.Text,
  554.                                  ProgressBar1,Panel1)
  555.         else
  556.           DoWriteTableDefsToFile(AFileList,RestTbl,Edit1.Text,
  557.                                  FieldIDCB.Checked,ProgressBar1,Panel1);
  558.       end
  559.       else
  560.       begin
  561.         if IdxCB.Checked then
  562.           DoRecoverIndicesFromFile(AFileList,RestDB,RestTbl,
  563.                                    ProgressBar1,Panel1,
  564.                                    DeleteCB.Checked)
  565.         else
  566.           DoRestructureFromFile(AFileList,RestDB,RestTbl,ProgressBar1,Panel1,
  567.                                 TblCreateCB.Checked,IndexCB.Checked,
  568.                                 RefIntCB.Checked,ValcheckCB.Checked,
  569.                                 DeleteCB.Checked); {}
  570.           {DoSimpleRestructureFromFile(AFileList,RestDB,RestTbl,ProgressBar1,Panel1,
  571.                                 TblCreateCB.Checked,IndexCB.Checked,
  572.                                 DeleteCB.Checked); {}
  573.       end;
  574.     end;
  575.   finally
  576.     AFileList.Free;
  577.   end;
  578. end;
  579.  
  580. procedure TMainForm.FormShow(Sender: TObject);
  581. begin
  582.   if not FCalced then
  583.   begin
  584.     CalcControlSize(self);
  585.     {$IFDEF WIN32}
  586.     FBDEVersion := BDEGetIdapi32Version;
  587.     {$ELSE}
  588.     FBDEVersion := BDEGetIdapi16Version;
  589.     {$ENDIF}
  590.     FCalced := True;
  591.     FPreventSizing := True;
  592.   end;
  593. end;
  594.  
  595. procedure TMainForm.AliasCBChange(Sender: TObject);
  596. begin
  597.   if (AliasCB.Text <> 'use Directories') then
  598.     DirBox1.Directory := BDEGetDBPath(AliasCB.Text);
  599.   DirBox1.Enabled := (AliasCB.Text = 'use Directories');
  600.   DriveBox1.Enabled := (AliasCB.Text = 'use Directories');
  601. end;
  602.  
  603. procedure TMainForm.FormCreate(Sender: TObject);
  604. var Handle: THandle;
  605.     ExeName: array[0..240] of char;
  606. begin
  607.   StrPCopy(ExeName,Application.ExeName);
  608.   Handle := GetModuleHandle(ExeName);
  609.   {$IFDEF WIN32}
  610.   ProgressBar1 := TProgressBar.Create(self);
  611.   {$ELSE}
  612.   ProgressBar1 := TGauge.Create(self); {}
  613.   {$ENDIF}
  614.   with ProgressBar1 do
  615.   begin
  616.     Parent := Panel2;
  617.     Align := alClient;
  618.     Visible := True;
  619.   end;{}
  620.   Session.GetAliasNames(AliasCB.Items);
  621.   AliasCB.Items.Insert(0,'use Directories');
  622.   AliasCB.ItemIndex := 0;
  623.   OpRGClick(self);
  624. end;
  625.  
  626. procedure TMainForm.AllBtnClick(Sender: TObject);
  627. var i: integer;
  628. begin
  629.   with FileBox1 do
  630.   begin
  631.     Items.BeginUpdate;
  632.     for i := pred(Items.Count) downto 0 do
  633.       Selected[i] := (Sender = AllBtn);
  634.     Items.EndUpdate;
  635.   end;
  636.   FileBox1Change(Sender);
  637. end;
  638.  
  639. procedure TMainForm.CloseBtnClick(Sender: TObject);
  640. begin
  641.   Application.Terminate;
  642. end;
  643.  
  644. procedure TMainForm.OpRGClick(Sender: TObject);
  645. var i: integer;
  646. begin
  647.   for i:=0 to pred(ComponentCount) do
  648.     if (Components[i] is TCheckBox)
  649.     and (Components[i].Tag < 2) then
  650.       TCheckBox(Components[i]).Enabled := (OpRG.ItemIndex = 1)
  651.                                           xor (Components[i].Tag = 1);
  652.   FileBox1.Items.BeginUpdate;
  653.   if (OpRG.ItemIndex = 0) then
  654.   begin
  655.     FileBox1.Mask := '*.db;*.dbf';
  656.     GroupBox4.Caption := ' Tables ';
  657.   end
  658.   else
  659.   begin
  660.     if IdxCB.Checked then
  661.       FileBox1.Mask := '*.dbx'
  662.     else
  663.       FileBox1.Mask := '*.dbi';
  664.     GroupBox4.Caption := ' Def-files ';
  665.   end;
  666.   FileBox1.Items.EndUpdate;
  667.   Edit1.Enabled := (OpRG.ItemIndex = 0);
  668.   Label1.Enabled := (OpRG.ItemIndex = 0);
  669.   FileBox1.Update;
  670.   {$IFDEF WIN32}
  671.   ProgressBar1.Position := 0;
  672.   {$ELSE}
  673.   ProgressBar1.Progress := 0;{}
  674.   {$ENDIF}
  675.   Panel1.Caption := ' Idle...';
  676. end;
  677.  
  678. procedure TMainForm.FileBox1Change(Sender: TObject);
  679. begin
  680.   DoItBtn.Enabled := (FileBox1.SelCount > 0);
  681. end;
  682.  
  683. procedure TMainForm.Label1Click(Sender: TObject);
  684. begin
  685.   TblCreateCB.Checked := not TblCreateCB.Checked;
  686. end;
  687.  
  688. procedure TMainForm.IdxCBClick(Sender: TObject);
  689. begin
  690.   IndexCB.Enabled := (not IdxCB.Checked) and (OpRG.ItemIndex = 1);
  691.   RefIntCB.Enabled := (not IdxCB.Checked) and (OpRG.ItemIndex = 1);
  692.   ValcheckCB.Enabled := (not IdxCB.Checked) and (OpRG.ItemIndex = 1);
  693.   TblCreateCB.Enabled := (not IdxCB.Checked) and (OpRG.ItemIndex = 1);
  694.   FieldIDCB.Enabled := (not IdxCB.Checked) and (OpRG.ItemIndex = 0);
  695.   if (OpRG.ItemIndex = 0) then Exit;
  696.   if IdxCB.Checked then
  697.     FileBox1.Mask := '*.dbx'
  698.   else
  699.     FileBox1.Mask := '*.dbi';
  700.   FileBox1.Update;
  701.   {$IFDEF WIN32}
  702.   ProgressBar1.Position := 0;
  703.   {$ELSE}
  704.   ProgressBar1.Progress := 0; {}
  705.   {$ENDIF}
  706.   Panel1.Caption := ' Idle...';
  707. end;
  708.  
  709. procedure TMainForm.ValcheckCBClick(Sender: TObject);
  710. begin
  711.   if ValcheckCB.Checked and (FBDEVersion = '4.00') then
  712.     case MessageDlg('You are using version '+FBDEVersion+' of BDE.'+#13#10
  713.                +'Due to a serious bug in this version there is no way'+#13#10
  714.                +'valcheck deletes correctly'+#13#10
  715.                +#13#10
  716.                +'Possible remedies:'+#13#10
  717.                +#13#10
  718.                +'Choose "Yes" to delete all *.VAL files before (re-)creation.'+#13#10
  719.                +'Note that this will also delete all RI checks for the tables'+#13#10
  720.                +'Don''t forget to recreate them as well.'+#13#10
  721.                +#13#10
  722.                +'Choose "No" for an internal error handling that will not'+#13#10
  723.                +'delete the checks but only "null" them.',
  724.                mtConfirmation,mbYesNoCancel,0) of
  725.      mrYes: FDeleteVals := True;
  726.      mrNo:  FDeleteVals := False;
  727.      mrCancel: ValcheckCB.Checked := False;
  728.    end;
  729. end;
  730.  
  731. procedure TMainForm.WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo);
  732. begin
  733.   inherited;
  734.   if FPreventSizing then
  735.     with (self), Msg.MinMaxInfo^ do
  736.     begin
  737.       ptMinTrackSize.x:= Width;
  738.       ptMaxTrackSize.x:= Width;
  739.       ptMinTrackSize.y:= Height;
  740.       ptMaxTrackSize.y:= Height;
  741.     end;
  742. end;
  743.  
  744. procedure TMainForm.WMInitMenuPopup(var Msg: TWMInitMenuPopup);
  745. begin
  746.   inherited;
  747.   if FPreventSizing and Msg.SystemMenu then
  748.   begin
  749.     EnableMenuItem(Msg.MenuPopup, SC_SIZE, MF_BYCOMMAND or MF_GRAYED);
  750.     EnableMenuItem(Msg.MenuPopup, SC_MAXIMIZE, MF_BYCOMMAND or MF_GRAYED);
  751.   end;
  752. end;
  753.  
  754. procedure TMainForm.WMNCHitTest(var Msg: TWMNCHitTest);
  755. begin
  756.   inherited;
  757.   if FPreventSizing then
  758.     with Msg do
  759.       if Result in [HTLEFT, HTRIGHT, HTBOTTOM, HTBOTTOMRIGHT,
  760.                     HTBOTTOMLEFT, HTTOP, HTTOPRIGHT, HTTOPLEFT] then
  761.          Result := longint(HTNOWHERE);
  762. end;
  763.  
  764. end.
  765.